Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/sftgrd/softgrid.frm

Visual Basic Form | 1996-06-12 | 23.9 KB | 683 lines

VERSION 2.00
Begin Form Form1
   Caption         =   "Form1"
   ClientHeight    =   8340
   ClientLeft      =   1095
   ClientTop       =   1485
   ClientWidth     =   7365
   Height          =   8745
   Left            =   1035
   LinkTopic       =   "Form1"
   ScaleHeight     =   8340
   ScaleWidth      =   7365
   Top             =   1140
   Width           =   7485
   Begin ListBox GridLst
      Height          =   5295
      Left            =   120
      TabIndex        =   0
      Top             =   1920
      Width           =   6735
   End
   Begin Label GridLblTitles
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "GridLblTitles"
      Height          =   255
      Index           =   11
      Left            =   5520
      TabIndex        =   12
      Top             =   1080
      Width           =   1095
   End
   Begin Label GridLblTitles
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "GridLblTitles"
      Height          =   255
      Index           =   10
      Left            =   4440
      TabIndex        =   11
      Top             =   1080
      Width           =   1095
   End
   Begin Label GridLblTitles
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "GridLblTitles"
      Height          =   255
      Index           =   9
      Left            =   3360
      TabIndex        =   10
      Top             =   1080
      Width           =   1095
   End
   Begin Label GridLblTitles
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "GridLblTitles"
      Height          =   255
      Index           =   8
      Left            =   2280
      TabIndex        =   9
      Top             =   1080
      Width           =   1095
   End
   Begin Label GridLblTitles
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "GridLblTitles"
      Height          =   255
      Index           =   7
      Left            =   1200
      TabIndex        =   8
      Top             =   1080
      Width           =   1095
   End
   Begin Label GridLblTitles
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "GridLblTitles"
      Height          =   255
      Index           =   6
      Left            =   120
      TabIndex        =   7
      Top             =   1080
      Width           =   1095
   End
   Begin Label GridLblTitles
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "GridLblTitles"
      Height          =   255
      Index           =   5
      Left            =   5520
      TabIndex        =   6
      Top             =   720
      Width           =   1095
   End
   Begin Label GridLblTitles
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "GridLblTitles"
      Height          =   255
      Index           =   4
      Left            =   4440
      TabIndex        =   5
      Top             =   720
      Width           =   1095
   End
   Begin Label GridLblTitles
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "GridLblTitles"
      Height          =   255
      Index           =   3
      Left            =   3360
      TabIndex        =   4
      Top             =   720
      Width           =   1095
   End
   Begin Label GridLblTitles
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "GridLblTitles"
      Height          =   255
      Index           =   2
      Left            =   2280
      TabIndex        =   3
      Top             =   720
      Width           =   1095
   End
   Begin Label GridLblTitles
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "GridLblTitles"
      Height          =   255
      Index           =   1
      Left            =   1200
      TabIndex        =   2
      Top             =   720
      Width           =   1095
   End
   Begin Label GridLblTitles
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "GridLblTitles"
      Height          =   255
      Index           =   0
      Left            =   120
      TabIndex        =   1
      Top             =   720
      Width           =   375
   End
   Begin Menu GridMnuTitleFields
      Caption         =   "&Title Field..."
      Visible         =   0   'False
      Begin Menu GridMnuChange
         Caption         =   "&Change Columns"
      End
      Begin Menu GridMnuFit
         Caption         =   "&Best Fit ColumnsTo Form"
      End
      Begin Menu GridMnuSort
         Caption         =   "&Sort Column"
      End
   End
': VB-GRID.FRM
'-    Simulates a GRID.VBX
'     Requires
'        2_GROUPS.FRM
'        2_GROUPS.BAS
'        WIN.BAS
'        INI_FILE.BAS
' Copyright 1994, AA-Software International
'     Distributed for non-commercial educational use only.
'     For other use contact:
'        AA-Software International
'        12 ter Domaine Du Bois Joli
'        06330 Roquefort-Les-Pins, France
'        Tel: [phone]
'        Fax: [phone]
'        Internet: [e-mail]
'        CompuServe: 100343,2570
Option Explicit
' Programmer provided data
Dim MyData() As testRecord          'Records to display
Dim MyDataIdx() As Integer          'Index
Dim MyDataNb As Integer             'Nb of records in MyData. -1 indicates empty
Dim MyInfoRow_i As Integer         'Used to step through data
Const MyIniFileName = "SoftGrid.ini"
Const MyIniSectionPrefix = "SoftGrid"
' SoftGrid Data
Const GridLblTitlesNb = 12             'Maximum nb of fields the form can handel
Dim GridFieldsNb As Integer            'Nb of all fields that can be displayed on from
Dim GridFieldNames_s() As String       'List of all field names that can be displayed on form
Dim GridDispFieldsNb As Integer           'Nb of fields the user has selected to be displayed on form
Dim GridDispIdx() As Integer              'Index to fields to be displaied (indexes into GridFieldNames_s() and pMyInfo)
Dim GridTitleLefts() As Integer       'Left positions of grid title lables
Dim GridLeft As Integer               'Starting left postion of grid
Dim GridMinimumFieldWidth As Integer  'Minimum width of any field
Dim GridWidth As Integer              'Current total width of grid
Dim GridBottom As Integer              'Distance from bottom of form
'Used to manage user resize the width of a field
Dim GridFieldIndex As Integer
Dim GridMouseLeft_b As Integer
Dim GridMouseRight_b As Integer
Dim GridPreviousMouse_i As Integer
Const GridClickWidth = 80
Sub Form_Load ()
   If Not myFields_Init_b() Then
      Unload Me
   End If
   ' Initalizd Grid
   GridInit
End Sub
Sub Form_Resize ()
   GridResize
End Sub
' =================== SoftGrid Starts Here ==================
Function GridFitText (ByVal width_i As Integer, ByVal text_s As String) As String
   width_i = width_i / 1.1
   Do While Me.TextWidth(text_s) >= width_i
      text_s = Left$(text_s, Len(text_s) - 1)
   Loop
   GridFitText = text_s
End Function
Sub GridIniGet ()
   IniSetFileName MyIniFileName
   IniSetAppName MyIniSectionPrefix & "DisplayFields"
   GridDispFieldsNb = IniGetInteger("GridDispFieldsNb", -1)
   If GridDispFieldsNb = -1 Then Exit Sub

   ReDim GridDispIdx(GridDispFieldsNb - 1)
   Dim dispFieldKtr As Integer
   For dispFieldKtr = 0 To GridDispFieldsNb - 1
      GridDispIdx(dispFieldKtr) = IniGetInteger("dispField_" & Format$(dispFieldKtr), dispFieldKtr)
   Next dispFieldKtr
   ReDim GridTitleLefts(GridDispFieldsNb)
   Dim titleLeftsKtr As Integer
   For titleLeftsKtr = 0 To GridDispFieldsNb
      GridTitleLefts(titleLeftsKtr) = IniGetInteger("fieldLeft_" & Format$(titleLeftsKtr), titleLeftsKtr * 120)
   Next titleLeftsKtr
End Sub
Sub GridIniPut ()
   IniSetFileName MyIniFileName
   IniSetAppName MyIniSectionPrefix & "DisplayFields"
   IniPutInteger "GridDispFieldsNb", GridDispFieldsNb
   If GridDispFieldsNb = -1 Then Exit Sub

   Dim dispFieldKtr As Integer
   For dispFieldKtr = 0 To GridDispFieldsNb - 1
      IniPutInteger "dispField_" & Format$(dispFieldKtr), GridDispIdx(dispFieldKtr)
   Next dispFieldKtr
   Dim titleLeftsKtr As Integer
   For titleLeftsKtr = 0 To GridDispFieldsNb
      IniPutInteger "fieldLeft_" & Format$(titleLeftsKtr), GridTitleLefts(titleLeftsKtr)
   Next titleLeftsKtr
End Sub
Sub GridInit ()
   'Create initial list of fields to be displayed
   myFields_GetFieldNames GridFieldNames_s()
   GridFieldsNb = UBound(GridFieldNames_s) + 1
   GridIniGet
   If GridDispFieldsNb = -1 Then
      If GridFieldsNb >= 2 Then
     GridDispFieldsNb = 2
      Else
     GridDispFieldsNb = 1
      End If
      ReDim GridDispIdx(GridDispFieldsNb - 1)
      Dim i As Integer
      For i = 0 To GridDispFieldsNb - 1
     GridDispIdx(i) = i
      Next i
      'Calc placement of titles
      GridSetTitleLefts GridTitleLefts(), GridDispFieldsNb
   End If
   ' Hide grid titles to keep from flashing
   Dim GridLblTitlesKtr As Integer
   For GridLblTitlesKtr = 0 To GridLblTitlesNb - 1

      GridLblTitles(GridLblTitlesKtr).Visible = False
   Next GridLblTitlesKtr
End Sub
Sub GridLblTitles_DblClick (index As Integer)
   Dim GridPreviousMouse_i As Integer
   GridPreviousMouse_i = MousePointer
   MousePointer = 11
   myFields_Open
   Dim fieldLargest_s As String
   Dim fieldLen As Integer
   Dim fieldLenMax As Integer
   fieldLenMax = 0
   Dim rowKtr As Integer
   rowKtr = 0
   Do Until myFields_EOF()
      fieldLen = Len(myFields_GetField_s(GridDispIdx(index)))
      If fieldLen > fieldLenMax Then
     fieldLenMax = fieldLen
     fieldLargest_s = myFields_GetField_s(GridDispIdx(index))
      End If

      myFields_GetNextField
      rowKtr = rowKtr + 1
   Loop
   GridLst.Refresh
   Dim newWidth As Integer
   newWidth = Me.TextWidth(fieldLargest_s) * 1.2
   GridSetNewWidth newWidth, index
   GridIniPut
   Form_Resize
   MousePointer = GridPreviousMouse_i
End Sub
Sub GridLblTitles_MouseDown (index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
   Const LEFT_BUTTON = 1
   Const RIGHT_BUTTON = 2
   Const MIDDLE_BUTTON = 4
   Const SHIFT_MASK = 1
   Const CTRL_MASK = 2
   Const ALT_MASK = 4
   If Button = LEFT_BUTTON Then
      GridMouseLeft_b = True
   ElseIf Button = RIGHT_BUTTON Then
      GridFieldIndex = index
      GridMouseRight_b = True
      Me.PopupMenu GridMnuTitleFields, 0, x, y
   End If
End Sub
Sub GridLblTitles_MouseMove (index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
   If GridMouseRight_b Then Exit Sub
   Dim distanceFromSeparator As Integer
   distanceFromSeparator = GridLblTitles(index).Width - x
   If distanceFromSeparator < GridClickWidth And distanceFromSeparator >= 0 And y > 15 And GridLblTitles(index).Height - y > 15 Then
      If MousePointer <> 9 Then
     GridPreviousMouse_i = MousePointer
     MousePointer = 9
      End If
      If GridMouseLeft_b Then
     If x < GridMinimumFieldWidth Then x = GridMinimumFieldWidth
     GridLblTitles(index).Width = x
     GridLblTitles(index).ZOrder 0
     GridLblTitles(index).Refresh
      End If
   Else
      If GridMouseLeft_b Then
     If x < GridMinimumFieldWidth Then x = GridMinimumFieldWidth
     GridLblTitles(index).Width = x
     GridLblTitles(index).ZOrder 0
     GridLblTitles(index).Refresh
      Else
     MousePointer = GridPreviousMouse_i
      End If
   End If

End Sub
Sub GridLblTitles_MouseUp (index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
   If GridMouseRight_b Then
      GridMouseRight_b = False
      Exit Sub
   End If
   If GridMouseLeft_b Then
      GridMouseLeft_b = False
      MousePointer = GridPreviousMouse_i
      Dim distanceFromSeparator As Integer
      distanceFromSeparator = GridLblTitles(index).Width - x
      If distanceFromSeparator < GridClickWidth And distanceFromSeparator >= 0 Then

     Dim newWidth As Integer
     If x > GridMinimumFieldWidth Then
        newWidth = x
     Else
        Beep
        newWidth = GridMinimumFieldWidth
     End If
     GridSetNewWidth newWidth, index
     GridIniPut
     Form_Resize
      End If
   End If
End Sub
Function GridListCount () As Integer
   GridListCount = GridLst.ListCount
End Function
Sub GridLst_Click ()
   myFields_GridClick GridLst.ListIndex
End Sub
Sub GridLst_DblClick ()
   myFields_GridDblClick GridLst.ListIndex
End Sub
Sub GridMnuChange_Click ()
   tgp_initialize "Grid Headings", "Headings Not To Dispaly", "Headings To Display"
   tgp_SetLeftListSorted True       'Allows easy selection by user
   tgp_SetRightListSorted False     'Allows insertion by user
   Dim allPosibleFieldsKtr As Integer
   For allPosibleFieldsKtr = 0 To UBound(GridFieldNames_s)
      Dim fieldToDisplayKtr As Integer
      For fieldToDisplayKtr = 0 To UBound(GridDispIdx)
     If GridDispIdx(fieldToDisplayKtr) = allPosibleFieldsKtr Then Exit For
      Next fieldToDisplayKtr
      If fieldToDisplayKtr <= UBound(GridDispIdx) Then
     tgp_addRightSide GridFieldNames_s(allPosibleFieldsKtr)
      Else
     tgp_addLeftSide GridFieldNames_s(allPosibleFieldsKtr)
      End If
   Next allPosibleFieldsKtr
   If tgp_ShowForm_s() = "OK" Then
      GridDispFieldsNb = tpg_RightListCount_i()
      ReDim GridDispIdx(GridDispFieldsNb - 1)
      For fieldToDisplayKtr = 0 To UBound(GridDispIdx)
     Dim nextFieldName As String
     nextFieldName = tgp_RightList_s(fieldToDisplayKtr)
     For allPosibleFieldsKtr = 0 To UBound(GridFieldNames_s)
        If GridFieldNames_s(allPosibleFieldsKtr) = nextFieldName Then Exit For
     Next allPosibleFieldsKtr
     If allPosibleFieldsKtr <= UBound(GridFieldNames_s) Then
        GridDispIdx(fieldToDisplayKtr) = allPosibleFieldsKtr
     End If
      Next fieldToDisplayKtr
      GridSetTitleLefts GridTitleLefts(), GridDispFieldsNb

      GridIniPut
      Form_Resize
   End If
End Sub
Sub GridMnuFit_Click ()
   Dim gridTitleLeft  As Integer
   gridTitleLeft = GridLeft
   GridWidth = Me.ScaleWidth - GridLeft * 2
   Dim gridTitleWidth  As Integer
   gridTitleWidth = GridWidth \ GridDispFieldsNb
   If gridTitleWidth < GridMinimumFieldWidth Then gridTitleWidth = GridMinimumFieldWidth
   Dim GridLblTitlesKtr As Integer
   GridLblTitlesKtr = 0
   Do While GridLblTitlesKtr <= GridDispFieldsNb
      GridTitleLefts(GridLblTitlesKtr) = gridTitleLeft
      gridTitleLeft = gridTitleLeft + gridTitleWidth
      GridLblTitlesKtr = GridLblTitlesKtr + 1
   Loop
   GridIniPut
   Form_Resize
End Sub
Sub GridMnuSort_Click ()
   mySortField GridDispIdx(GridFieldIndex)
   Form_Resize
End Sub
'GridResetTitleLefts
Sub GridResize ()
   Dim GridPreviousMouse_i As Integer
   GridPreviousMouse_i = MousePointer
   MousePointer = 11
   ' Determin position params
   Dim gridTitleTop  As Integer
   gridTitleTop = GridLblTitles(0).Top
   Dim gridTitleHeight As Integer
   gridTitleHeight = GridLblTitles(0).Height
   If GridLeft = 0 Then GridLeft = GridLblTitles(0).Left
   If GridMinimumFieldWidth = 0 Then GridMinimumFieldWidth = GridLblTitles(0).Width
   If GridBottom = 0 Then GridBottom = Me.ScaleHeight - (GridLst.Top + GridLst.Height)
   GridWidth = Me.ScaleWidth - GridLeft * 2
   ' Position GridLblTitles
   Dim lastGridTitleDisplayed As Integer
   Dim GridLblTitlesKtr As Integer
   GridLblTitlesKtr = 0

   ' Step thru each grid lable
   Do While GridLblTitlesKtr < GridLblTitlesNb
      ' Make lable visiable
      If (GridLblTitlesKtr < GridDispFieldsNb) Then
     'Ensure lable is not off the form
     If (GridTitleLefts(GridLblTitlesKtr + 1) - GridLeft <= GridWidth) Then
        GridLblTitles(GridLblTitlesKtr).Top = gridTitleTop
        GridLblTitles(GridLblTitlesKtr).Left = GridTitleLefts(GridLblTitlesKtr)
        GridLblTitles(GridLblTitlesKtr).Width = GridTitleLefts(GridLblTitlesKtr + 1) - GridTitleLefts(GridLblTitlesKtr)
        GridLblTitles(GridLblTitlesKtr).Caption = GridFieldNames_s(GridDispIdx(GridLblTitlesKtr))
        GridLblTitles(GridLblTitlesKtr).Visible = True
        lastGridTitleDisplayed = GridLblTitlesKtr
     Else
        GridLblTitles(GridLblTitlesKtr).Visible = False
     End If
      Else
     GridLblTitles(GridLblTitlesKtr).Visible = False
      End If
      GridLblTitlesKtr = GridLblTitlesKtr + 1
   Loop
   ' Update the grid itself
   ' Position GridLst
   GridLst.Top = gridTitleTop + gridTitleHeight
   GridLst.Left = GridLeft
   GridLst.Width = GridLblTitles(lastGridTitleDisplayed).Left - GridLeft + GridLblTitles(lastGridTitleDisplayed).Width
   Dim newGridHeight As Integer
   newGridHeight = Me.ScaleHeight - GridBottom - GridLst.Top
   If newGridHeight < 120 Then newGridHeight = 120
   GridLst.Height = newGridHeight
   ' Set list box tabs to match grid headings
   ReDim GridLstTabStops(GridDispFieldsNb - 2) As Integer
   Dim i As Integer
   For i = 1 To GridDispFieldsNb - 1
      GridLstTabStops(i - 1) = (GridLblTitles(i).Left - GridLeft) / Me.TextWidth("H") * 1.44
   Next i
   win_ListBoxSetTabs GridLst, GridLstTabStops()
   ' Put data into grid
   GridLst.Clear
   ReDim listGridInfo(GridDispFieldsNb - 1) As String
   myFields_Open
   Dim rowKtr As Integer
   rowKtr = 0
   Do Until myFields_EOF()
      For i = 0 To GridDispFieldsNb - 1
     listGridInfo(i) = GridFitText(GridLblTitles(i).Width, myFields_GetField_s(GridDispIdx(i)))
      Next i
      myFields_GetNextField
      win_ListBoxAddTabItems GridLst, listGridInfo()
      rowKtr = rowKtr + 1
   Loop
   GridLst.Refresh
   MousePointer = GridPreviousMouse_i
End Sub
Function GridSelected (ByVal row_i As Integer) As Integer
   GridSelected = GridLst.Selected(row_i)
End Function
Sub GridSetNewWidth (newWidth As Integer, index As Integer)
     Dim changeInWidth As Integer
     changeInWidth = newWidth - (GridTitleLefts(index + 1) - GridTitleLefts(index))

     'make sure we don't go past end of form
     If GridTitleLefts(index + 1) + changeInWidth > GridWidth Then
        changeInWidth = GridWidth - GridTitleLefts(index + 1)
        Beep
        Beep
     End If
     'change all following positions
     Dim i As Integer
        For i = index + 1 To UBound(GridTitleLefts)
           GridTitleLefts(i) = GridTitleLefts(i) + changeInWidth
     Next i
End Sub
Sub GridSetTitleLefts (GridTitleLefts() As Integer, ByVal GridDispFieldsNb As Integer)
   ReDim GridTitleLefts(GridDispFieldsNb)
   If GridLeft = 0 Then GridLeft = GridLblTitles(0).Left
   If GridMinimumFieldWidth = 0 Then GridMinimumFieldWidth = GridLblTitles(0).Width
   Dim gridTitleLeft  As Integer
   gridTitleLeft = GridLeft
   GridWidth = Me.ScaleWidth - GridLeft * 2
   Dim gridTitleWidth  As Integer
   gridTitleWidth = GridWidth \ GridDispFieldsNb
   If gridTitleWidth < GridMinimumFieldWidth Then gridTitleWidth = GridMinimumFieldWidth
   Dim GridLblTitlesKtr As Integer
   GridLblTitlesKtr = 0
   Do While GridLblTitlesKtr <= GridDispFieldsNb
      GridTitleLefts(GridLblTitlesKtr) = gridTitleLeft
      gridTitleLeft = gridTitleLeft + gridTitleWidth
      GridLblTitlesKtr = GridLblTitlesKtr + 1
   Loop
End Sub
' =================== SoftGrid Ends Here ==================
Function myFields_EOF () As Integer
   If MyDataNb = -1 Then
      myFields_EOF = True
   Else
      myFields_EOF = MyInfoRow_i >= MyDataNb
   End If
End Function
Function myFields_GetField_s (ByVal field_i As Integer) As String
   Dim index As Integer
   index = MyDataIdx(MyInfoRow_i)
   If Not myFields_EOF() And field_i < GridFieldsNb Then
      Select Case field_i
      Case 0
     myFields_GetField_s = MyData(index).Zero
      Case 1
     myFields_GetField_s = MyData(index).One
      Case 2
     myFields_GetField_s = MyData(index).Two
      Case 3
     myFields_GetField_s = MyData(index).Three
      Case 4
     myFields_GetField_s = MyData(index).Four
      Case 5
     myFields_GetField_s = MyData(index).Five
      Case 6
     myFields_GetField_s = MyData(index).Six
      Case 7
     myFields_GetField_s = MyData(index).Seven
      Case 8
     myFields_GetField_s = MyData(index).Eight
      Case 9
     myFields_GetField_s = MyData(index).Nine
      Case 10
     myFields_GetField_s = MyData(index).Ten
      End Select
      Else
      myFields_GetField_s = ""
   End If
End Function
Sub myFields_GetFieldNames (filedNames_s() As String)
   ReDim filedNames_s(10)
   filedNames_s(0) = "Zero"
   filedNames_s(1) = "One"
   filedNames_s(2) = "Two"
   filedNames_s(3) = "Three"
   filedNames_s(4) = "Four"
   filedNames_s(5) = "Five"
   filedNames_s(6) = "Six"
   filedNames_s(7) = "Seven"
   filedNames_s(8) = "Eight"
   filedNames_s(9) = "Nine"
   filedNames_s(10) = "Ten"
End Sub
Sub myFields_GetNextField ()
   MyInfoRow_i = MyInfoRow_i + 1
End Sub
Sub myFields_GridClick (ByVal index As Integer)
   Beep
End Sub
Sub myFields_GridDblClick (ByVal index As Integer)
   Beep
End Sub
Function myFields_Init_b () As Integer
   'Set Field values
   MyDataNb = 30
   ReDim MyData(MyDataNb - 1)
   ReDim MyDataIdx(MyDataNb - 1)
   Dim rowKtr As Integer
   For rowKtr = 0 To MyDataNb - 1
      MyDataIdx(rowKtr) = rowKtr
      MyData(rowKtr).Zero = Format$(Rnd * 100) & "-zero"
      MyData(rowKtr).One = Format$(Rnd * 100) & "-one"
      MyData(rowKtr).Two = Format$(Rnd * 100) & "-two"
      MyData(rowKtr).Three = Format$(Rnd * 100) & "-three"
      MyData(rowKtr).Four = Format$(Rnd * 100) & "-four"
      MyData(rowKtr).Five = Format$(Rnd * 100) & "-five"
      MyData(rowKtr).Six = Format$(Rnd * 100) & "-six"
      MyData(rowKtr).Seven = Format$(Rnd * 100) & "-seven"
      MyData(rowKtr).Eight = Format$(Rnd * 100) & "-eight"
      MyData(rowKtr).Nine = Format$(Rnd * 100) & "-nine"
      MyData(rowKtr).Ten = Format$(Rnd * 100) & "-ten"
   Next rowKtr
   myFields_Init_b = True
End Function
Sub myFields_Open ()
   If MyDataNb <> -1 Then
      MyInfoRow_i = LBound(MyData)
   End If
End Sub
Sub mySortField (ByVal fieldToSortOn As Integer)

      '
      ' To perform this sort, you need the Registered version of AAVBSORT.DLL
      '
      SortIdxTextRecord MyData(), testRecord_ut, MyDataIdx(), fieldToSortOn + 1
      ' The Shareware version AAVBSORT.DLL is available on:
      '     CompuServe Forum: MSBASIC
      '     Lib:  17
      '     File: AASORT.ZIO
      '
      ' The file ORDER.TXT contains information on how to acquire the
      ' registered version of AAVBSORT.DLL. You can also contact:
      '
      '     C.Scott Willy
      '     Commercial Director
      '     AA-Software International
      '     12 ter Domaine Du Bois Joli
      '     6330 Roquefort -Les - Pins, France
      '
      '     Tel: [phone]
      '     Fax: [phone]
      '     Internet: [e-mail]
      '     CompuServe: 100343,2570

End Sub